home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / G-Games / (c)gb.d64 / thirteen pegs.d (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  6KB  |  181 lines
  1. 1 REM - THIRTEEN PEG PUZZLE FOR COMMODORE 64
  2. 2 REM- DANIEL MILLER
  3. 3 REM- 2815 34 STREET
  4. 4 REM- ASTORIA, QUEENS
  5. 5 REM- NEW YORK, NEW YORK   11103
  6. 6 REM APRIL 6, 1983
  7. 7 REM********************************
  8. 20 DIM B(14),C(14),A$(9),ER$(3)
  9. 30 GOSUB10000:GOTO1005
  10. 35 REM- SOUND ROUTINE
  11. 40 POKEVO,15:POKEWV,17:POKEAT,15:POKEHI,68:POKELO,149
  12. 50 FOR TM=1 TO 100:NEXT TM:POKEWV,0
  13. 55 POKEVO,15:POKEWV,17:POKEAT,15:POKEHI,34:POKELO,75
  14. 60 FOR TM=1 TO 100:NEXT TM:POKEWV,0:RETURN
  15. 300 REM- PUZZLE SCREEN
  16. 302 PRINTCHR$(19);TAB(22-(LEN(HDG$)/2));HDG$
  17. 303 PRINT LEFT$(DO$,7);
  18. 305 X=49:FOR Y=1196 TO 1212 STEP3:POKEY+54272,14:POKEY,X:X=X+1:NEXT Y
  19. 310 PRINTTAB(11)A$(B(1));UP$;A$(B(2));UP$;A$(B(3));UP$;A$(B(4));UP$;A$(B(5))
  20. 317 IF VAL(F2$)<>1 THEN320
  21. 318 GOSUB40
  22. 320 PRINTTAB(14)A$(B(6));UP$;A$(B(7));UP$;A$(B(8));UP$;A$(B(9))
  23. 327 IF VAL(F2$)<>2 THEN330
  24. 328 GOSUB40
  25. 330 PRINTTAB(14)A$(B(10));UP$;A$(B(11));UP$;A$(B(12));UP$;A$(B(13));UP$;
  26. 332 PRINTTAB(26)A$(B(14))
  27. 337 IF VAL(F2$)<>3 THEN355
  28. 338 GOSUB40
  29. 355 X=49:FOR Y=1313 TO 1553 STEP120:POKEY+54272,14:POKEY,X:X=X+1:NEXT Y
  30. 360 PRINTLEFT$(DO$,21);TAB(18);MV$;
  31. 365 PRINTLEFT$(DO$,23);TAB(12);F3$;TAB(27);T3$;
  32. 366 IF ZZ=1 THEN FOR TM=1 TO 2000:NEXT TM:RETURN
  33. 370 REM- PUZZLE SOLVED ?
  34. 375 IF D$=D1$ THEN600
  35. 400 PRINTLEFT$(DO$,23);TAB(20);"    ";TAB(31);"    ";
  36. 405 PRINTLEFT$(DO$,23);TAB(20);"   ";LEFT$(DO$,23);TAB(20);CR$;
  37. 410 GET F$:IF F$="" THEN410
  38. 412 GET G$:IF G$="" THEN412
  39. 415 FR$=F$+G$:PRINT FR$;:F$="":G$=""
  40. 417 IF FR$="99" THEN8310
  41. 419 IF LEFT$(FR$,1)<"1" OR LEFT$(FR$,1)>"3" THEN FR$="":GOTO405
  42. 421 IF RIGHT$(FR$,1)<"1" OR RIGHT$(FR$,1)>"6" THEN FR$="":GOTO405
  43. 423 H=VAL(FR$):F1=H:GOSUB8000:FR=H:C(FR)=VAL(MID$(D$,FR,1))
  44. 430 PRINTLEFT$(DO$,23);TAB(31);"    ";LEFT$(DO$,23);TAB(32);CR$;
  45. 432 GET F$:IF F$="" THEN432
  46. 434 GET G$:IF G$="" THEN434
  47. 436 TU$=F$+G$:PRINTTU$;:F$="":G$=""
  48. 438 IF LEFT$(TU$,1)<"1" OR LEFT$(TU$,1)>"3" THEN TU$="":GOTO430
  49. 440 IF RIGHT$(TU$,1)<"1" OR RIGHT$(TU$,1)>"6" THEN TU$="":GOTO430
  50. 442 H=VAL(TU$):T1=H:GOSUB8000:TU=H:C(TU)=VAL(MID$(D$,TU,1))
  51. 443 F2$=LEFT$(FR$,1)
  52. 444 FR$=MID$(D$,FR,1):TU$=MID$(D$,TU,1)
  53. 445 IF FR$="6" OR FR$="3" OR FR$="7" THEN ER=1:GOTO900
  54. 446 IF TU$="1" OR TU$="8" OR TU$="2" OR TU$="9" THEN ER=2:GOTO900
  55. 447 IF TU$="4" OR TU$="5" THEN ER=2:GOTO900
  56. 451 IF FR$="1" AND TU$="6" THEN C(TU)=6:C(FR)=1:GOTO468
  57. 452 IF FR$="2" AND TU$="6" THEN C(TU)=7:C(FR)=8:GOTO468
  58. 453 IF FR$="2" AND TU$="7" THEN C(TU)=7:C(FR)=2:GOTO468
  59. 454 IF FR$="4" AND TU$="6" THEN C(TU)=3:C(FR)=8:GOTO468
  60. 455 IF FR$="5" AND TU$="7" THEN C(TU)=3:C(FR)=9:GOTO468
  61. 456 IF FR$="8" AND TU$="3" THEN C(TU)=6:C(FR)=4:GOTO468
  62. 457 IF FR$="9" AND TU$="3" THEN C(TU)=7:C(FR)=5:GOTO468
  63. 458 IF FR$="5" AND TU$="6" THEN C(TU)=3:C(FR)=1:GOTO468
  64. 459 IF FR$="4" AND TU$="7" THEN C(TU)=3:C(FR)=2:GOTO468
  65. 464 IF FR$="1" THEN C(TU)=6:C(FR)=5:GOTO468
  66. 465 IF FR$="4" THEN C(TU)=3:C(FR)=4:GOTO468
  67. 466 IF FR$="2" THEN C(TU)=7:C(FR)=4:GOTO468
  68. 468 C=C(TU):C(TU)=C(FR):C(FR)=C
  69. 472 IF ABS(F1-T1)=2 OR ABS(F1-T1)=20 THEN710
  70. 475 D$="":FOR X=1 TO 14:D$=D$+RIGHT$(STR$(C(X)),1):NEXT X
  71. 480 PRINTLEFT$(DO$,23);TAB(20);"    ";TAB(31);"    ";
  72. 490 FOR X=1 TO 14:B(X)=VAL(MID$(D$,X,1)):NEXT X
  73. 500 MV=MV+1:MO$=RV$+WH$+STR$(MV)+RO$:PRINTLEFT$(DO$,21);TAB(25);MO$;:GOTO302
  74. 600 FOR X=1 TO 5
  75. 610 PRINTLEFT$(DO$,25);TAB(8);WIN$;:FOR TM=1 TO 500:NEXT TM
  76. 620 PRINTLEFT$(DO$,25);TAB(8);ER$(0);:FOR TM=1 TO 500:NEXT TM:NEXT X
  77. 630 GOTO8310
  78. 700 REM- JUMP ROUTINE
  79. 710 IF ABS(F1-T1)=20 THEN J=1:GOTO720
  80. 715 J=2:GOTO750
  81. 720 IF F1>T1 THEN726
  82. 725 H=F1+10:GOTO730
  83. 726 H=F1-10
  84. 730 GOSUB8000:C(H)=3:GOTO475
  85. 750 IF F1>T1 THEN756
  86. 755 H=F1+1:GOTO760
  87. 756 H=F1-1
  88. 760 GOSUB8000:C(H)=3:GOTO475
  89. 899 REM- FLASH ERROR MESSAGES
  90. 900 F2$="":FOR X=1 TO 5
  91. 910 PRINT LEFT$(DO$,25);TAB(22-LEN(ER$(ER))/2);ER$(ER);:FOR TM=1 TO 500:NEXT TM
  92. 920 PRINT LEFT$(DO$,25);TAB(9);ER$(0);:FOR TM=1 TO 500:NEXT TM:NEXT X:GOTO302
  93. 1000 REM- INSTRUCTIONS
  94. 1005 POKE 53281,1
  95. 1010 PRINT CL$;LEFT$(DO$,3);TAB(11);H2$:PRINT:PRINT
  96. 1020 PRINT"     [212]HIS PUZZLE CAN BE SOLVED IN 11":PRINT:PRINT"   MOVES.":PRINT
  97. 1040 PRINT"     [208]EGS ARE ARRANGED ON THE PLAYING":PRINT
  98. 1050 PRINT"   SCREEN AS FOLLOWS:"
  99. 1060 ZZ=1:FOR TM=1 TO 2000:NEXT TM:PRINT CL$;UC$;:GOSUB1500:POKE53281,1
  100. 1070 PRINT CL$;LEFT$(DO$,3);TAB(11);H2$:PRINT:PRINT:ZZ=0
  101. 1080 PRINT"     [210]EMOVE THE [215]HITE PEGS FROM THE":PRINT
  102. 1090 PRINT"   PLAYING SCREEN.":PRINT:PRINT
  103. 1100 PRINT"     [205]OVE EACH PEG TO AN EMPTY SPACE OR":PRINT
  104. 1110 PRINT"   OVER ANOTHER PEG TO AN EMPTY SPACE.":PRINT:PRINT
  105. 1115 PRINT"     [212]HE [194]LACK PEG MUST AGAIN BE IN":PRINT
  106. 1116 PRINT"   POSITION 11 ON THE LAST MOVE.":PRINT:PRINT
  107. 1120 PRINT"     [199]OOD [204]UCK AND [200]APPY [208]UZZLING !"
  108. 1130 FOR TM=1 TO 3000:NEXT TM
  109. 1500 GOSUB11000:FOR X=1 TO LEN(D$):B(X)=VAL(MID$(D$,X,1)):C(X)=B(X):NEXT:F2$=""
  110. 1510 MV=0:POKE53281,11:PRINT CL$;UC$;:GOTO302
  111. 8000 REM- CONVERT 'FROM-TO' TO POSITION IN STRING
  112. 8010 IF H=11 THEN H=1:RETURN
  113. 8020 IF H=12 THEN H=2:RETURN
  114. 8030 IF H=13 THEN H=3:RETURN
  115. 8040 IF H=14 THEN H=4:RETURN
  116. 8050 IF H=15 THEN H=5:RETURN
  117. 8060 IF H=22 THEN H=6:RETURN
  118. 8070 IF H=23 THEN H=7:RETURN
  119. 8080 IF H=24 THEN H=8:RETURN
  120. 8090 IF H=25 THEN H=9:RETURN
  121. 8100 IF H=32 THEN H=10:RETURN
  122. 8110 IF H=33 THEN H=11:RETURN
  123. 8120 IF H=34 THEN H=12:RETURN
  124. 8130 IF H=35 THEN H=13:RETURN
  125. 8140 IF H=36 THEN H=14:RETURN
  126. 8200 REM- MOVE INVALID
  127. 8210 FOR X=1 TO 5
  128. 8220 PRINTLEFT$(DO$,25);TAB(9);ER$(3);:FOR TM=1 TO 500:NEXT TM
  129. 8230 PRINTLEFT$(DO$,25);TAB(9);ER$(0);:FOR TM=1 TO 500:NEXT TM
  130. 8240 NEXT X:F2$="":GOTO302
  131. 8300 REM- END PUZZLE MESSAGE
  132. 8310 PRINTLEFT$(DO$,25);TAB(7);EN$;:FOR TM=1 TO 1500:NEXT TM:PRINT CL$:END
  133. 10000 REM- BUILD CHARACTER GRAPHICS
  134. 10100 WH$=CHR$(5):BLK$=CHR$(144):RED$=CHR$(28):GRN$=CHR$(30):YEL$=CHR$(158)
  135. 10105 CYN$=CHR$(159):B2LU$=CHR$(31)
  136. 10110 DW$=CHR$(17):UP$=CHR$(145)+CHR$(145)
  137. 10120 FOR X=1 TO 24:DO$=DO$+DW$:NEXT X:DO$=CHR$(19)+DO$
  138. 10130 LF$=CHR$(157)+CHR$(157)+CHR$(157)
  139. 10140 LC$=CHR$(14):UC$=CHR$(142)
  140. 10145 RV$=CHR$(18):RO$=CHR$(146)
  141. 10150 PEG$=CHR$(113):CL$=CHR$(147)
  142. 10160 A$(1)=RV$+RED$+"   "+RO$+DW$+LF$+RV$+RED$+" "+RO$+WH$+PE$
  143. 10165 A$(1)=A$(1)+RV$+RED$+" "+RO$+DW$+LF$+RV$+RED$+"   "+RO$
  144. 10170 A$(2)=RV$+GRN$+"   "+RO$+DW$+LF$+RV$+GRN$+" "+RO$+BLK$+PE$
  145. 10175 A$(2)=A$(2)+RV$+GRN$+" "+RO$+DW$+LF$+RV$+GRN$+"   "+RO$
  146. 10180 A$(3)=RV$+YEL$+"   "+RO$+DW$+LF$+RV$+YEL$+"   "+RO$
  147. 10185 A$(3)=A$(3)+DW$+LF$+RV$+YEL$+"   "+RO$
  148. 10190 A$(4)=RV$+YEL$+"   "+RO$+DW$+LF$+RV$+YEL$+" "+RO$+BLK$+PE$
  149. 10195 A$(4)=A$(4)+RV$+YEL$+" "+RO$+DW$+LF$+RV$+YEL$+"   "+RO$
  150. 10200 A$(5)=RV$+YEL$+"   "+RO$+DW$+LF$+RV$+YEL$+" "+RO$+WH$+PE$
  151. 10205 A$(5)=A$(5)+RV$+YEL$+" "+RO$+DW$+LF$+RV$+YEL$+"   "+RO$
  152. 10210 A$(6)=RV$+RED$+"   "+RO$+DW$+LF$+RV$+RED$+"   "+RO$
  153. 10215 A$(6)=A$(6)+DW$+LF$+RV$+RED$+"   "+RO$
  154. 10220 A$(7)=RV$+GRN$+"   "+RO$+DW$+LF$+RV$+GRN$+"   "+RO$
  155. 10225 A$(7)=A$(7)+DW$+LF$+RV$+GRN$+"   "+RO$
  156. 10230 A$(8)=RV$+RED$+"   "+RO$+DW$+LF$+RV$+RED$+" "+RO$+BLK$+PE$
  157. 10235 A$(8)=A$(8)+RV$+RED$+" "+RO$+DW$+LF$+RV$+RED$+"   "+RO$
  158. 10240 A$(9)=RV$+GRN$+"   "+RO$+DW$+LF$+RV$+GRN$+" "+RO$+WH$+PE$
  159. 10245 A$(9)=A$(9)+RV$+GRN$+" "+RO$+DW$+LF$+RV$+GRN$+"   "+RO$
  160. 10400 CR$=RV$+YEL$+" "+RO$
  161. 10410 HDG$=RV$+WH$+"THIRTEEN PEG PUZZLE"+RO$
  162. 10420 H2$=LC$+RV$+B2$+"[212]HIRTEEN [208]EG [208]UZZLE"+RO$
  163. 10430 F3$=RV$+CYN$+"FROM ?"+RO$:T3$=RV$+CYN$+"TO ?"+RO$
  164. 10440 MV$=RV$+YEL$+"MOVE #"+RO$
  165. 10445 REM- ERROR MESSAGES
  166. 10450 ER$(0)="                            "
  167. 10460 ER$(1)=RV$+YEL$+"'FROM' POSITION EMPTY"+RO$
  168. 10470 ER$(2)=RV$+YEL$+"'TO' POSITION OCCUPIED"+RO$
  169. 10480 ER$(3)=RV$+YEL$+"INVALID 'FROM-TO' POSITION"+RO$
  170. 10490 REM- END PUZZLE MESSAGE
  171. 10495 EN$=RV$+WH$+"THANKS FOR PLAYING.  'BYE."+RO$
  172. 10500 REM- PUZZLE SOLVED !
  173. 10505 WIN$=RV$+WH$+"YOU SOLVED THE PUZZLE !"+RO$
  174. 10510 REM- SOUND PARAMETERS
  175. 10515 VO=54296:WV=54276:AT=54277:HI=54273:LO=54272:F2$=""
  176. 10600 RETURN
  177. 10999 REM- PUZZLE FORMAT
  178. 11000 D$="85555555555557"
  179. 11009 REM PUZZLE SOLVED FORMAT
  180. 11010 D1$="83333333333337":RETURN
  181.